!/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!*  Copyleft (!c) 2004-2005 Div. Nucl. Med., Cyric, Tohoku Univ.    *
!*  Copyleft (!c) 2005-2011 Elseif Laboratory.                      *
!*  elseifkk@users.sf.net                                           *
!*                                                                  *
!*  All Rights Reversed.                                            *
!*                                                                  *
!*                                                                  *
!*  LICENSE AGREEMENT:                                              *
!*                                                                  *
!*  You agree that we don't agree to anything.                      *
!*                                                                  *
!*                                                                  *
!*  DISCLAIMER OF WARRANTIES:                                       *
!*                                                                  *
!*  This software is provided to you "AS IS," and the authors and   *
!*  contributors disclaim any warranty or liability obligations to  *
!*  you of any kind, implied or express, including but not limited  *
!*  to the warranties of merchantability, fitness for a particular  *
!*  purpose, and non-infringement.                                  *
!* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
!
! procs used to register a pair of images.
! 
! TTD:
!   1) implimentation of sheer and magnify.
! note:
!   none.
!
module MatchMaker
  use buty
  implicit none
  type(image_data),private,pointer::mm_ref
  type(image_data),private,pointer::mm_tar
  type(rigid_transform_param),private,pointer::mm_rtp
  integer*4,private::mm_inttype_D=1
  integer*4,private::mm_inttype_R=1
  real*8,private,allocatable::mm_h2d(:,:,:)
contains
  subroutine set_pair(tar,ref)
    use buty
    type(image_data),intent(in),target::ref
    type(image_data),intent(in),target::tar
    mm_ref=>ref
    mm_tar=>tar
    if(allocated(mm_h2d)) deallocate(mm_h2d)
    allocate(mm_h2d(tar%ns,ref%ns,2))  
    call regist_buty_work_space(mm_h2d)
  end subroutine set_pair
  !
  subroutine set_rtp(rtp)
    type(rigid_transform_param),intent(in),target::rtp
    mm_rtp=>rtp
  end subroutine set_rtp
  !
  real*8 function cost_D(x)
    use buty
    real*8,intent(in)::x(3)
    mm_rtp%d=x
    cost_D=get_mi_w_rtp(mm_rtp,mm_tar,mm_ref)
  end function cost_D
  !
  real*8 function cost_R(x)
    use buty
    real*8,intent(in)::x(3)
    mm_rtp%t=x
    cost_R=get_mi_w_rtp(mm_rtp,mm_tar,mm_ref)
  end function cost_R
  !
  real*8 function Cost_RD(x)
    use buty
    real*8,intent(in)::x(6)
    mm_rtp%d=x(1:3)
    mm_rtp%t=x(4:6)
    cost_RD=get_mi_w_rtp(mm_rtp,mm_tar,mm_ref)
  end function Cost_RD
  !
  real*8 function cost_D_nr(x)
    use buty
    real*8,intent(in)::x(3)
    mm_rtp%d=x
    cost_D_nr=get_mi_w_nrtp(mm_rtp,mm_tar,mm_ref)
  end function cost_D_nr
  !
  real*8 function cost_R_nr(x)
    use buty
    real*8,intent(in)::x(3)
    mm_rtp%t=x
    cost_R_nr=get_mi_w_nrtp(mm_rtp,mm_tar,mm_ref)
  end function cost_R_nr
  !
  real*8 function Cost_RD_nr(x)
    use buty
    real*8,intent(in)::x(6)
    mm_rtp%d=x(1:3)
    mm_rtp%t=x(4:6)
    cost_RD_nr=get_mi_w_nrtp(mm_rtp,mm_tar,mm_ref)
  end function Cost_RD_nr
  !
  real*8 function cost_S_nr(x)
    use buty
    real*8,intent(in)::x(3)
    mm_rtp%s=x
    cost_S_nr=get_mi_w_nrtp(mm_rtp,mm_tar,mm_ref)
  end function cost_S_nr
  !
  real*8 function cost_M_nr(x)
    use buty
    real*8,intent(in)::x(3)
    mm_rtp%m=x
    cost_M_nr=get_mi_w_nrtp(mm_rtp,mm_tar,mm_ref)
  end function cost_M_nr
  !
  real*8 function Cost_SM_nr(x)
    use buty
    real*8,intent(in)::x(6)
    mm_rtp%s=x(1:3)
    mm_rtp%m=x(4:6)
    cost_SM_nr=get_mi_w_nrtp(mm_rtp,mm_tar,mm_ref)
  end function Cost_SM_nr
  !
  !
  !
  real*8 function cost_D_chi2(x)
    use buty
    real*8,intent(in)::x(3)
    mm_rtp%d=x
    cost_D_chi2=get_chi2_w_rtp(mm_rtp,mm_tar,mm_ref)
  end function cost_D_chi2
  !
  real*8 function cost_R_chi2(x)
    use buty
    real*8,intent(in)::x(3)
    mm_rtp%t=x
    cost_R_chi2=get_chi2_w_rtp(mm_rtp,mm_tar,mm_ref)
  end function cost_R_chi2
  !
  real*8 function Cost_RD_chi2(x)
    use buty
    real*8,intent(in)::x(6)
    mm_rtp%d=x(1:3)
    mm_rtp%t=x(4:6)
    cost_RD_chi2=get_chi2_w_rtp(mm_rtp,mm_tar,mm_ref)
  end function Cost_RD_chi2
  !
  subroutine dump_h2d(fout,ftar,fref)
    character*(*),intent(in)::fout
    character*(*),intent(in)::ftar,fref
    real*8,parameter::max_ratio=1.d-3
    integer*4 i,j,nx,ny
    real*8 hmax
    if(.not.allocated(mm_h2d)) return
    nx=size(mm_h2d,1)
    ny=size(mm_h2d,2)
    hmax=maxval(mm_h2d)
    open(unit=1,file=fout)
    write(1,*) "$ DATA=CONTOUR"
    write(1,*) "% nx=",nx
    write(1,*) "% ny=",ny
    write(1,*) "% cmax=",hmax*max_ratio
    write(1,*) "% cstep =",hmax*max_ratio/64
    write(1,*) "% splinetype = 3"
    write(1,*) "% contstyle = 2"
    write(1,*) "% xlabel =",trim(ftar)
    write(1,*) "% ylabel =",trim(fref)
    write(1,*) "% zlabel = counts/bin"
    write(1,*) "% toplabel = ''"
    do j=1,ny
       do i=1,nx
          write(1,*) mm_h2d(i,j,1)
       end do
    end do
    close(1)
  end subroutine dump_h2d
end module MatchMaker
